0. Podsumowanie

Na podstawie zebranych danych widać zdecydowaną tendencję do karłowacenia śledzi. Najwyzsza korelacja występuje między długością śledzi, a temperaturą przy powierzchni wody. Drugą wartość pod względem korelacji miała oscylacja północnoatlantycka, która jest mocno związana z temperaturą. Ponadto parametr temperatury przy powierzchni miał najwyższą wartość ważności. Świadczy to o tym, że zmiany klimatyczne mają największy wpływ na rozmiar śledzi.

1. Kod wyliczający wykorzystane biblioteki.

library(knitr) #prezentacja wyników
library(dplyr) #data frame
library(ggplot2) #wizualizacja
library(plotly) #interaktywne wykresy
library(caret) #regresja
library(randomForest) #random forest
library(corrplot) # wykres korelacji

2. Powtarzalność wyników

set.seed(23)

3. Wczytanie danych z pliku

rawCSV <- read.csv("~/Downloads/sledzie.csv", na.strings = "?")
str(rawCSV)
## 'data.frame':    52582 obs. of  16 variables:
##  $ X     : int  0 1 2 3 4 5 6 7 8 9 ...
##  $ length: num  23 22.5 25 25.5 24 22 24 23.5 22.5 22.5 ...
##  $ cfin1 : num  0.0278 0.0278 0.0278 0.0278 0.0278 ...
##  $ cfin2 : num  0.278 0.278 0.278 0.278 0.278 ...
##  $ chel1 : num  2.47 2.47 2.47 2.47 2.47 ...
##  $ chel2 : num  NA 21.4 21.4 21.4 21.4 ...
##  $ lcop1 : num  2.55 2.55 2.55 2.55 2.55 ...
##  $ lcop2 : num  26.4 26.4 26.4 26.4 26.4 ...
##  $ fbar  : num  0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 ...
##  $ recr  : int  482831 482831 482831 482831 482831 482831 482831 482831 482831 482831 ...
##  $ cumf  : num  0.306 0.306 0.306 0.306 0.306 ...
##  $ totaln: num  267381 267381 267381 267381 267381 ...
##  $ sst   : num  14.3 14.3 14.3 14.3 14.3 ...
##  $ sal   : num  35.5 35.5 35.5 35.5 35.5 ...
##  $ xmonth: int  7 7 7 7 7 7 7 7 7 7 ...
##  $ nao   : num  2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 ...

4. Kod przetwarzający brakujące dane

Usunięcie elementów, które zawierają niepełne dane (NA)

completeRows <- rawCSV[complete.cases(rawCSV), ]

liczba wierszy przed filtrowaniem

allRowsNumber <- nrow(rawCSV)
allRowsNumber
## [1] 52582

Pomiary posiadające niepełne dane:

allRowsNumber - nrow(completeRows)
## [1] 10094

Procent niepełnych danych:

(allRowsNumber - nrow(completeRows)) / allRowsNumber
## [1] 0.1919668

Około 20% procent danych nie posiadało pełnej informacji. Te dane były równo rozłożone w całym zbiorze danych, co pozowliło mi zadecydować, żeby je usunąć.

5. Sekcja podsumowującą rozmiar zbioru i podstawowe statystyki.

Krótkie podsumowanie statystyk wartości atrybutów:

summary(completeRows[-1])
##      length         cfin1             cfin2             chel1       
##  Min.   :19.0   Min.   : 0.0000   Min.   : 0.0000   Min.   : 0.000  
##  1st Qu.:24.0   1st Qu.: 0.0000   1st Qu.: 0.2778   1st Qu.: 2.469  
##  Median :25.5   Median : 0.1111   Median : 0.7012   Median : 5.750  
##  Mean   :25.3   Mean   : 0.4457   Mean   : 2.0269   Mean   :10.016  
##  3rd Qu.:26.5   3rd Qu.: 0.3333   3rd Qu.: 1.7936   3rd Qu.:11.500  
##  Max.   :32.5   Max.   :37.6667   Max.   :19.3958   Max.   :75.000  
##      chel2            lcop1              lcop2             fbar       
##  Min.   : 5.238   Min.   :  0.3074   Min.   : 7.849   Min.   :0.0680  
##  1st Qu.:13.427   1st Qu.:  2.5479   1st Qu.:17.808   1st Qu.:0.2270  
##  Median :21.435   Median :  7.0000   Median :24.859   Median :0.3320  
##  Mean   :21.197   Mean   : 12.8386   Mean   :28.396   Mean   :0.3306  
##  3rd Qu.:27.193   3rd Qu.: 21.2315   3rd Qu.:37.232   3rd Qu.:0.4650  
##  Max.   :57.706   Max.   :115.5833   Max.   :68.736   Max.   :0.8490  
##       recr              cumf             totaln             sst       
##  Min.   : 140515   Min.   :0.06833   Min.   : 144137   Min.   :12.77  
##  1st Qu.: 360061   1st Qu.:0.14809   1st Qu.: 306068   1st Qu.:13.60  
##  Median : 421391   Median :0.23191   Median : 539558   Median :13.86  
##  Mean   : 519877   Mean   :0.22987   Mean   : 515082   Mean   :13.87  
##  3rd Qu.: 724151   3rd Qu.:0.29803   3rd Qu.: 730351   3rd Qu.:14.16  
##  Max.   :1565890   Max.   :0.39801   Max.   :1015595   Max.   :14.73  
##       sal            xmonth            nao          
##  Min.   :35.40   Min.   : 1.000   Min.   :-4.89000  
##  1st Qu.:35.51   1st Qu.: 5.000   1st Qu.:-1.90000  
##  Median :35.51   Median : 8.000   Median : 0.20000  
##  Mean   :35.51   Mean   : 7.252   Mean   :-0.09642  
##  3rd Qu.:35.52   3rd Qu.: 9.000   3rd Qu.: 1.63000  
##  Max.   :35.61   Max.   :12.000   Max.   : 5.08000

6. Rozkład wartości atrybutów

length: długość złowionego śledzia [cm];

ggplot(completeRows, mapping = aes(x = length)) + geom_histogram(fill="blue", color="black", binwidth = 1)

cfin1: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 1];

ggplot(completeRows, mapping = aes(x = cfin1)) + geom_histogram(fill="blue", color="black", binwidth = 1)

cfin2: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 2];

ggplot(completeRows, mapping = aes(x = cfin2)) + geom_histogram(fill="blue", color="black", binwidth = 1)

chel1: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 1];

ggplot(completeRows, mapping = aes(x = chel1)) + geom_histogram(fill="blue", color="black", binwidth = 1)

chel2: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 2];

ggplot(completeRows, mapping = aes(x = chel2)) + geom_histogram(fill="blue", color="black", binwidth = 1)

lcop1: dostępność planktonu [zagęszczenie widłonogów gat. 1];

ggplot(completeRows, mapping = aes(x = lcop1)) + geom_histogram(fill="blue", color="black", binwidth = 1)

lcop2: dostępność planktonu [zagęszczenie widłonogów gat. 2];

ggplot(completeRows, mapping = aes(x = lcop2)) + geom_histogram(fill="blue", color="black", binwidth = 1)

fbar: natężenie połowów w regionie [ułamek pozostawionego narybku];

ggplot(completeRows, mapping = aes(x = fbar)) + geom_histogram(fill="blue", color="black", binwidth = .01)

recr: roczny narybek [liczba śledzi];

ggplot(completeRows, mapping = aes(x = recr)) + geom_histogram(fill="blue", color="black", binwidth = 25000)

cumf: łączne roczne natężenie połowów w regionie [ułamek pozostawionego narybku];

ggplot(completeRows, mapping = aes(x = cumf)) + geom_histogram(fill="blue", color="black", binwidth = .01)

totaln: łączna liczba ryb złowionych w ramach połowu [liczba śledzi];

ggplot(completeRows, mapping = aes(x = totaln)) + geom_histogram(fill="blue", color="black", binwidth = 10000)

sst: temperatura przy powierzchni wody [°C];

ggplot(completeRows, mapping = aes(x = sst)) + geom_histogram(fill="blue", color="black", binwidth = 0.05)

sal: poziom zasolenia wody [Knudsen ppt];

ggplot(completeRows, mapping = aes(x = sal)) + geom_histogram(fill="blue", color="black", binwidth = 0.01)

xmonth: miesiąc połowu [numer miesiąca];

ggplot(completeRows, mapping = aes(x = xmonth)) + geom_histogram(fill="blue", color="black", binwidth = 1)

nao: oscylacja północnoatlantycka [mb].

ggplot(completeRows, mapping = aes(x = nao)) + geom_histogram(fill="blue", color="black", binwidth = 1)

7. Korelacja między zmiennymi

corData <- cor(completeRows)
corrplot(corData, method = "number", type = "upper", order="AOE", addCoefasPercent = TRUE)

Wartość korelacji interesuje nas głównie pomiędzy długością śledzia, a innymi zebranymi parametrami. Z wykresu wynika, że zdecydowanie największą bezwzględną korelację posiada długość śledzia z temperaturą powierzchniową wody. Wynosi ona -0.45. Druga co do wartości korelacji jest wartość parametru oscylacji północnoatlantyckiej. Jest ona dość mocno skorelowana też z temperaturą powierzchni wody. Z tej analizy wynika, że klimat ma duży wpływ na rozmiar śledzi.

8. Rozmiar śledzi w czasie

8.1 rozmiar w miesiącach

month_length <- group_by(completeRows, xmonth) %>%
  summarize(avg_length = mean(length))

plot <- ggplot(month_length, aes(x=xmonth, y=avg_length)) +
  geom_line() +
  geom_point() +
  geom_smooth()
ggplotly(plot)
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

8.2 rozmiar w latach

year_group <- completeRows %>%
  group_by(recr, add=TRUE) %>%
  summarise(avg_length = mean(length)) %>%
  arrange(row_number()) %>%
  mutate(rok=row_number())

year_group
plot <- ggplot(year_group, aes(x=rok, y=avg_length))+
  geom_line() +
  geom_point() +
  geom_smooth()
ggplotly(plot)
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Analizując wykres rozmiarów śledzia w latach widać tendencję do ich karłowacenia. W analizie miesięcznej można zauważyć, że śledzie najwieksze rozmiary osiagaja w okolicach czerwca.

9. Budowa regresora

Zbiór treningowy i zbiór testowy został podzielony w proporcjach 70/30. Do funkcji uczącej został wykorzystany algorytm RandomForest i jako metryka RMSE.

cleaned_data_for_training = select(.data = completeRows, -X)
idx <- createDataPartition(cleaned_data_for_training$length, p=0.7, list=F)
training <- cleaned_data_for_training[idx,]
testing <- cleaned_data_for_training[-idx,]

ctrl <- trainControl(
  method = "repeatedcv",
  number = 2,
  repeats = 5)

tunegrid <- expand.grid(mtry = 10:14)


fit <- train(length ~ .,
             data = training,
             method = "rf",
             metric = "RMSE",
             tuneGrid=tunegrid,
             trControl = ctrl,
             ntree = 15)


rfClasses <- predict(fit, newdata = testing)
data_to_summary <- data.frame(obs = testing$length, pred = rfClasses)
defaultSummary(data_to_summary)
##      RMSE  Rsquared       MAE 
## 1.1547540 0.5058816 0.9067785

10. Analiza ważności atrybutów modelu regresji

varImp(fit)
## rf variable importance
## 
##         Overall
## sst    100.0000
## recr    24.9018
## xmonth  13.9992
## lcop1   13.3667
## lcop2   11.1477
## fbar    10.4013
## totaln   8.8732
## cfin2    6.0729
## chel1    2.2363
## chel2    1.7853
## sal      1.5601
## cumf     0.9772
## nao      0.9469
## cfin1    0.0000
ggplot(varImp(fit))

Zdecydowanie największą wartość ważności posiada temperatura powierzchniowa wody i jest większa od kolejnej wartości ponad 4-krotnie, co pokazuje, zdecydowanie, że jest to najważniejszy parametr.